home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database Designers / Rational Rose 2000 / Rational Setup.EXE / common / lib / Win32 / ODBC.pm < prev    next >
Text File  |  1998-11-15  |  23KB  |  900 lines
  1. package Win32::ODBC;
  2.  
  3. $VERSION = '0.03';
  4.  
  5. # Win32::ODBC.pm
  6. #       +==========================================================+
  7. #       |                                                          |
  8. #       |                     ODBC.PM package                      |
  9. #       |                     ---------------                      |
  10. #       |                                                          |
  11. #       | Copyright (c) 1996, 1997 Dave Roth. All rights reserved. |
  12. #       |   This program is free software; you can redistribute    |
  13. #       | it and/or modify it under the same terms as Perl itself. |
  14. #       |                                                          |
  15. #       +==========================================================+
  16. #
  17. #
  18. #         based on original code by Dan DeMaggio (dmag@umich.edu)
  19. #
  20. #    Use under GNU General Public License or Larry Wall's "Artistic License"
  21. #
  22. #    Check the README.TXT file that comes with this package for details about
  23. #    it's history.
  24. #
  25.  
  26. require Exporter;
  27. require DynaLoader;
  28.  
  29. $ODBCPackage = "Win32::ODBC";
  30. $ODBCPackage::Version = 970208;
  31. $::ODBC = $ODBCPackage;
  32. $CacheConnection = 0;
  33.  
  34.     #   Reserve ODBC in the main namespace for US!
  35. *ODBC::=\%Win32::ODBC::;
  36.  
  37.  
  38. @ISA= qw( Exporter DynaLoader );
  39.     # Items to export into callers namespace by default. Note: do not export
  40.     # names by default without a very good reason. Use EXPORT_OK instead.
  41.     # Do not simply export all your public functions/methods/constants.
  42. @EXPORT = qw(
  43.             ODBC_ADD_DSN
  44.             ODBC_REMOVE_DSN
  45.             ODBC_CONFIG_DSN
  46.  
  47.             SQL_DONT_CLOSE
  48.             SQL_DROP
  49.             SQL_CLOSE
  50.             SQL_UNBIND
  51.             SQL_RESET_PARAMS
  52.  
  53.             SQL_FETCH_NEXT
  54.             SQL_FETCH_FIRST
  55.             SQL_FETCH_LAST
  56.             SQL_FETCH_PRIOR
  57.             SQL_FETCH_ABSOLUTE
  58.             SQL_FETCH_RELATIVE
  59.             SQL_FETCH_BOOKMARK
  60.  
  61.             SQL_COLUMN_COUNT
  62.             SQL_COLUMN_NAME
  63.             SQL_COLUMN_TYPE
  64.             SQL_COLUMN_LENGTH
  65.             SQL_COLUMN_PRECISION
  66.             SQL_COLUMN_SCALE
  67.             SQL_COLUMN_DISPLAY_SIZE
  68.             SQL_COLUMN_NULLABLE
  69.             SQL_COLUMN_UNSIGNED
  70.             SQL_COLUMN_MONEY
  71.             SQL_COLUMN_UPDATABLE
  72.             SQL_COLUMN_AUTO_INCREMENT
  73.             SQL_COLUMN_CASE_SENSITIVE
  74.             SQL_COLUMN_SEARCHABLE
  75.             SQL_COLUMN_TYPE_NAME
  76.             SQL_COLUMN_TABLE_NAME
  77.             SQL_COLUMN_OWNER_NAME
  78.             SQL_COLUMN_QUALIFIER_NAME
  79.             SQL_COLUMN_LABEL
  80.             SQL_COLATT_OPT_MAX
  81.             SQL_COLUMN_DRIVER_START
  82.             SQL_COLATT_OPT_MIN
  83.             SQL_ATTR_READONLY
  84.             SQL_ATTR_WRITE
  85.             SQL_ATTR_READWRITE_UNKNOWN
  86.             SQL_UNSEARCHABLE
  87.             SQL_LIKE_ONLY
  88.             SQL_ALL_EXCEPT_LIKE
  89.             SQL_SEARCHABLE
  90.         );
  91.     #The above are included for backward compatibility
  92.  
  93.  
  94. sub new
  95. {
  96.     my ($n, $self);
  97.     my ($type) = shift;
  98.     my ($DSN) = shift;
  99.     my (@Results) = @_;
  100.  
  101.     if (ref $DSN){
  102.         @Results = ODBCClone($DSN->{'connection'});
  103.     }else{
  104.         @Results = ODBCConnect($DSN, @Results);
  105.     }
  106.     @Results = processError(-1, @Results);
  107.     if (! scalar(@Results)){
  108.         return undef;
  109.     }
  110.     $self = bless {};
  111.     $self->{'connection'} = $Results[0];
  112.     $ErrConn = $Results[0];
  113.     $ErrText = $Results[1];
  114.     $ErrNum = 0;
  115.     $self->{'DSN'} = $DSN;
  116.     $self;
  117. }
  118.  
  119. ####
  120. #   Close this ODBC session (or all sessions)
  121. ####
  122. sub Close
  123. {
  124.     my ($self, $Result) = shift;
  125.     $Result = DESTROY($self);
  126.     $self->{'connection'} = -1;
  127.     return $Result;
  128. }
  129.  
  130. ####
  131. #   Auto-Kill an instance of this module
  132. ####
  133. sub DESTROY
  134. {
  135.     my ($self) = shift;
  136.     my (@Results) = (0);
  137.     if($self->{'connection'} > -1){
  138.         @Results = ODBCDisconnect($self->{'connection'});
  139.         @Results = processError($self, @Results);
  140.         if ($Results[0]){
  141.             undef $self->{'DSN'};
  142.             undef @{$self->{'fnames'}};
  143.             undef %{$self->{'field'}};
  144.             undef %{$self->{'connection'}};
  145.         }
  146.     }
  147.     return $Results[0];
  148. }
  149.  
  150.  
  151. sub sql{
  152.     return (Sql(@_));
  153. }
  154.  
  155. ####
  156. #   Submit an SQL Execute statement for processing
  157. ####
  158. sub Sql{
  159.     my ($self, $Sql, @Results) = @_;
  160.     @Results = ODBCExecute($self->{'connection'}, $Sql);
  161.     return updateResults($self, @Results);
  162. }
  163.  
  164. ####
  165. #   Retrieve data from a particular field
  166. ####
  167. sub Data{
  168.  
  169.         #   Change by JOC 06-APR-96
  170.         #   Altered by Dave Roth <dave@roth.net> 96.05.07
  171.     my($self) = shift;
  172.     my(@Fields) = @_;
  173.     my(@Results, $Results, $Field);
  174.  
  175.     if ($self->{'Dirty'}){
  176.         GetData($self);
  177.         $self->{'Dirty'} = 0;
  178.     }
  179.     @Fields = @{$self->{'fnames'}} if (! scalar(@Fields));
  180.     foreach $Field (@Fields) {
  181.         if (wantarray) {
  182.             push(@Results, data($self, $Field));
  183.         } else {
  184.             $Results .= data($self, $Field);
  185.         }
  186.     }
  187.     return wantarray ? @Results : $Results;
  188. }
  189.  
  190. sub DataHash{
  191.     my($self, @Results) = @_;
  192.     my(%Results, $Element);
  193.  
  194.     if ($self->{'Dirty'}){
  195.         GetData($self);
  196.         $self->{'Dirty'} = 0;
  197.     }
  198.     @Results = @{$self->{'fnames'}} if (! scalar(@Results));
  199.     foreach $Element (@Results) {
  200.         $Results{$Element} = data($self, $Element);
  201.     }
  202.  
  203.     return %Results;
  204. }
  205.  
  206. ####
  207. #   Retrieve data from the data buffer
  208. ####
  209. sub data
  210. {  $_[0]->{'data'}->{$_[1]}; }
  211.  
  212.  
  213. sub fetchrow{
  214.     return (FetchRow(@_));
  215. }
  216. ####
  217. #   Put a row from an ODBC data set into data buffer
  218. ####
  219. sub FetchRow{
  220.     my ($self, @Results) = @_;
  221.     my ($item, $num, $sqlcode);
  222.         # Added by JOC 06-APR-96
  223.         #   $num = 0;
  224.     $num = 0;
  225.     undef $self->{'data'};
  226.  
  227.  
  228.     @Results = ODBCFetch($self->{'connection'}, @Results);
  229.     if (! (@Results = processError($self, @Results))){
  230.         ####
  231.         #   There should be an innocuous error "No records remain"
  232.         #   This indicates no more records in the dataset
  233.         ####
  234.         return undef;
  235.     }
  236.         #   Set the Dirty bit so we will go and extract data via the
  237.         #   ODBCGetData function. Otherwise use the cache.
  238.     $self->{'Dirty'} = 1;
  239.  
  240.         #   Return the array of field Results.
  241.     return @Results;
  242. }
  243.  
  244. sub GetData{
  245.     my($self) = @_;
  246.     my(@Results, $num);
  247.  
  248.     @Results = ODBCGetData($self->{'connection'});
  249.     if (!(@Results = processError($self, @Results))){
  250.         return undef;
  251.     }
  252.         ####
  253.         #   This is a special case. Do not call processResults
  254.         ####
  255.     ClearError();
  256.     foreach (@Results){
  257.         s/ +$//; # HACK
  258.         $self->{'data'}->{ ${$self->{'fnames'}}[$num] } = $_;
  259.         $num++;
  260.     }
  261.         #   return is a hack to interface with a assoc array.
  262.     return wantarray? (1, 1): 1;
  263. }
  264.  
  265. ####
  266. #   See if any more ODBC Results Sets
  267. #        Added by Brian Dunfordshore <Brian_Dunfordshore@bridge.com> 
  268. #        96.07.10
  269. ####
  270. sub MoreResults{
  271.     my ($self) = @_;
  272.  
  273.     my(@Results) = ODBCMoreResults($self->{'connection'});
  274.     return (processError($self, @Results))[0];
  275. }
  276.  
  277. ####
  278. #   Retrieve the catalog from the current DSN
  279. #    NOTE: All Field names are uppercase!!!
  280. ####
  281. sub Catalog{
  282.     my ($self) = shift;
  283.     my ($Qualifier, $Owner, $Name, $Type) = @_;
  284.     my (@Results) = ODBCTableList($self->{'connection'}, $Qualifier, $Owner, $Name, $Type);
  285.  
  286.         #   If there was an error return 0 else 1
  287.     return (updateResults($self, @Results) != 1);
  288. }
  289.  
  290. ####
  291. #   Return an array of names from the catalog for the current DSN
  292. #       TableList($Qualifier, $Owner, $Name, $Type)
  293. #           Return: (array of names of tables)
  294. #    NOTE: All Field names are uppercase!!!
  295. ####
  296. sub TableList{
  297.     my ($self) = shift;
  298.     my (@Results) = @_;
  299.     if (! scalar(@Results)){
  300.         @Results = ("", "", "%", "TABLE");
  301.     }
  302.  
  303.     if (! Catalog($self, @Results)){
  304.         return undef;
  305.     }
  306.     undef @Results;
  307.     while (FetchRow($self)){
  308.         push(@Results, Data($self, "TABLE_NAME"));
  309.     }
  310.     return sort(@Results);
  311. }
  312.  
  313.  
  314. sub fieldnames{
  315.     return (FieldNames(@_));
  316. }
  317. ####
  318. #   Return an array of fieldnames extracted from the current dataset
  319. ####
  320. sub FieldNames { $self = shift; return @{$self->{'fnames'}}; }
  321.  
  322.  
  323. ####
  324. #   Closes this connection. This is used mostly for testing. You should
  325. #   probably use Close().
  326. ####
  327. sub ShutDown{
  328.     my($self) = @_;
  329.     print "\nClosing connection $self->{'connection'}...";
  330.     $self->Close();
  331.     print "\nDone\n";
  332. }
  333.  
  334. ####
  335. #   Return this connection number
  336. ####
  337. sub Connection{
  338.     my($self) = @_;
  339.     return $self->{'connection'};
  340. }
  341.  
  342. ####
  343. #   Returns the current connections that are in use.
  344. ####
  345. sub GetConnections{
  346.     return ODBCGetConnections();
  347. }
  348.  
  349. ####
  350. #   Set the Max Buffer Size for this connection. This determines just how much
  351. #   ram can be allocated when a fetch() is performed that requires a HUGE amount
  352. #   of memory. The default max is 10k and the absolute max is 100k.
  353. #   This will probably never be used but I put it in because I noticed a fetch()
  354. #   of a MEMO field in an Access table was something like 4Gig. Maybe I did
  355. #   something wrong, but after checking several times I decided to impliment
  356. #   this limit thingie.
  357. ####
  358. sub SetMaxBufSize{
  359.     my($self, $Size) = @_;
  360.     my(@Results) = ODBCSetMaxBufSize($self->{'connection'}, $Size);
  361.     return (processError($self, @Results))[0];
  362. }
  363.  
  364. ####
  365. #   Returns the Max Buffer Size for this connection. See SetMaxBufSize().
  366. ####
  367. sub GetMaxBufSize{
  368.     my($self) = @_;
  369.     my(@Results) = ODBCGetMaxBufSize($self->{'connection'});
  370.     return (processError($self, @Results))[0];
  371. }
  372.  
  373.  
  374. ####
  375. #   Returns the DSN for this connection as an associative array.
  376. ####
  377. sub GetDSN{
  378.     my($self, $DSN) = @_;
  379.     if(! ref($self)){
  380.         $DSN = $self;
  381.         $self = 0;
  382.     }
  383.     if (! $DSN){
  384.         $self = $self->{'connection'};
  385.     }
  386.     my(@Results) = ODBCGetDSN($self, $DSN);
  387.     return (processError($self, @Results));
  388. }
  389.  
  390. ####
  391. #   Returns an associative array of $XXX{'DSN'}=Description
  392. ####
  393. sub DataSources{
  394.     my($self, $DSN) = @_;
  395.     if(! ref $self){
  396.         $DSN = $self;
  397.         $self = 0;
  398.     }
  399.     my(@Results) = ODBCDataSources($DSN);
  400.     return (processError($self, @Results));
  401. }
  402.  
  403. ####
  404. #   Returns an associative array of $XXX{'Driver Name'}=Driver Attributes
  405. ####
  406. sub Drivers{
  407.     my($self) = @_;
  408.     if(! ref $self){
  409.         $self = 0;
  410.     }
  411.     my(@Results) = ODBCDrivers();
  412.     return (processError($self, @Results));
  413. }
  414.  
  415. ####
  416. #   Returns the number of Rows that were affected by the previous SQL command.
  417. ####
  418. sub RowCount{
  419.     my($self, $Connection) = @_;
  420.     if (! ref($self)){
  421.         $Connection = $self;
  422.         $self = 0;
  423.     }
  424.     if (! $Connection){$Connection = $self->{'connection'};}
  425.     my(@Results) = ODBCRowCount($Connection);
  426.     return (processError($self, @Results))[0];
  427. }
  428.  
  429. ####
  430. #   Returns the Statement Close Type -- how does ODBC Close a statment.
  431. #       Types:
  432. #           SQL_DROP
  433. #           SQL_CLOSE
  434. #           SQL_UNBIND
  435. #           SQL_RESET_PARAMS
  436. ####
  437. sub GetStmtCloseType{
  438.     my($self, $Connection) = @_;
  439.     if (! ref($self)){
  440.         $Connection = $self;
  441.         $self = 0;
  442.     }
  443.     if (! $Connection){$Connection = $self->{'connection'};}
  444.     my(@Results) = ODBCGetStmtCloseType($Connection);
  445.     return (processError($self, @Results));
  446. }
  447.  
  448. ####
  449. #   Sets the Statement Close Type -- how does ODBC Close a statment.
  450. #       Types:
  451. #           SQL_DROP
  452. #           SQL_CLOSE
  453. #           SQL_UNBIND
  454. #           SQL_RESET_PARAMS
  455. #   Returns the newly set value.
  456. ####
  457. sub SetStmtCloseType{
  458.     my($self, $Type, $Connection) = @_;
  459.     if (! ref($self)){
  460.         $Connection = $Type;
  461.         $Type = $self;
  462.         $self = 0;
  463.     }
  464.     if (! $Connection){$Connection = $self->{'connection'};}
  465.     my(@Results) = ODBCSetStmtCloseType($Connection, $Type);
  466.     return (processError($self, @Results))[0];
  467. }
  468.  
  469. sub ColAttributes{
  470.     my($self, $Type, @Field) = @_;
  471.     my(%Results, @Results, $Results, $Attrib, $Connection, $Temp);
  472.     if (! ref($self)){
  473.         $Type = $Field;
  474.         $Field = $self;
  475.         $self = 0;
  476.     }
  477.     $Connection = $self->{'connection'};
  478.     if (! scalar(@Field)){ @Field = $self->fieldnames;}
  479.     foreach $Temp (@Field){
  480.         @Results = ODBCColAttributes($Connection, $Temp, $Type);
  481.         ($Attrib) = processError($self, @Results);
  482.         if (wantarray){
  483.             $Results{$Temp} = $Attrib;
  484.         }else{
  485.             $Results .= "$Temp";
  486.         }
  487.     }
  488.     return wantarray? %Results:$Results;
  489. }
  490.  
  491. sub GetInfo{
  492.     my($self, $Type) = @_;
  493.     my($Connection, @Results);
  494.     if(! ref $self){
  495.         $Type = $self;
  496.         $self = 0;
  497.         $Connection = 0;
  498.     }else{
  499.         $Connection = $self->{'connection'};
  500.     }
  501.     @Results = ODBCGetInfo($Connection, $Type);
  502.     return (processError($self, @Results))[0];
  503. }
  504.  
  505. sub GetConnectOption{
  506.     my($self, $Type) = @_;
  507.     my(@Results);
  508.     if(! ref $self){
  509.         $Type = $self;
  510.         $self = 0;
  511.     }
  512.     @Results = ODBCGetConnectOption($self->{'connection'}, $Type);
  513.     return (processError($self, @Results))[0];
  514. }
  515.  
  516. sub SetConnectOption{
  517.     my($self, $Type, $Value) = @_;
  518.     if(! ref $self){
  519.         $Value = $Type;
  520.         $Type = $self;
  521.         $self = 0;
  522.     }
  523.     my(@Results) = ODBCSetConnectOption($self->{'connection'}, $Type, $Value);
  524.     return (processError($self, @Results))[0];
  525. }
  526.  
  527.  
  528. sub Transact{
  529.     my($self, $Type) = @_;
  530.     my(@Results);
  531.     if(! ref $self){
  532.         $Type = $self;
  533.         $self = 0;
  534.     }
  535.     @Results = ODBCTransact($self->{'connection'}, $Type);
  536.     return (processError($self, @Results))[0];
  537. }
  538.  
  539.  
  540. sub SetPos{
  541.     my($self, @Results) = @_;
  542.     @Results = ODBCSetPos($self->{'connection'}, @Results);
  543.     $self->{'Dirty'} = 1;
  544.     return (processError($self, @Results))[0];
  545. }
  546.  
  547. sub ConfigDSN{
  548.     my($self) = shift @_;
  549.     my($Type, $Connection);
  550.     if(! ref $self){
  551.         $Type = $self;
  552.         $Connection = 0;
  553.         $self = 0;
  554.     }else{
  555.         $Type = shift @_;
  556.         $Connection = $self->{'connection'};
  557.     }
  558.     my($Driver, @Attributes) = @_;
  559.     @Results = ODBCConfigDSN($Connection, $Type, $Driver, @Attributes);
  560.     return (processError($self, @Results))[0];
  561. }
  562.  
  563.  
  564. sub Version{
  565.     my($self, @Packages) = @_;
  566.     my($Temp, @Results);
  567.     if (! ref($self)){
  568.         push(@Packages, $self);
  569.     }
  570.     my($ExtName, $ExtVersion) = Info();
  571.     if (! scalar(@Packages)){
  572.         @Packages = ("ODBC.PM", "ODBC.PLL");
  573.     }
  574.     foreach $Temp (@Packages){
  575.         if ($Temp =~ /pll/i){
  576.             push(@Results, "ODBC.PM:$Win32::ODBC::Version");
  577.         }elsif ($Temp =~ /pm/i){
  578.             push(@Results, "ODBC.PLL:$ExtVersion");
  579.         }
  580.     }
  581.     return @Results;
  582. }
  583.  
  584.  
  585. sub SetStmtOption{
  586.     my($self, $Option, $Value) = @_;
  587.     if(! ref $self){
  588.         $Value = $Option;
  589.         $Option = $self;
  590.         $self = 0;
  591.     }
  592.     my(@Results) = ODBCSetStmtOption($self->{'connection'}, $Option, $Value);
  593.     return (processError($self, @Results))[0];
  594. }
  595.  
  596. sub GetStmtOption{
  597.     my($self, $Type) = @_;
  598.     if(! ref $self){
  599.         $Type = $self;
  600.         $self = 0;
  601.     }
  602.     my(@Results) = ODBCGetStmtOption($self->{'connection'}, $Type);
  603.     return (processError($self, @Results))[0];
  604. }
  605.  
  606. sub GetFunctions{
  607.     my($self, @Results)=@_;
  608.     @Results = ODBCGetFunctions($self->{'connection'}, @Results);
  609.     return (processError($self, @Results));
  610. }
  611.  
  612. sub DropCursor{
  613.     my($self) = @_;
  614.     my(@Results) = ODBCDropCursor($self->{'connection'});
  615.     return (processError($self, @Results))[0];
  616. }
  617.  
  618. sub SetCursorName{
  619.     my($self, $Name) = @_;
  620.     my(@Results) = ODBCSetCursorName($self->{'connection'}, $Name);
  621.     return (processError($self, @Results))[0];
  622. }
  623.  
  624. sub GetCursorName{
  625.     my($self) = @_;
  626.     my(@Results) = ODBCGetCursorName($self->{'connection'});
  627.     return (processError($self, @Results))[0];
  628. }
  629.  
  630. sub GetSQLState{
  631.     my($self) = @_;
  632.     my(@Results) = ODBCGetSQLState($self->{'connection'});
  633.     return (processError($self, @Results))[0];
  634. }
  635.  
  636.  
  637. # ----------- R e s u l t   P r o c e s s i n g   F u n c t i o n s ----------
  638. ####
  639. #   Generic processing of data into associative arrays
  640. ####
  641. sub updateResults{
  642.     my ($self, $Error, @Results) = @_;
  643.  
  644.     undef %{$self->{'field'}};
  645.  
  646.     ClearError($self);
  647.     if ($Error){
  648.         SetError($self, $Results[0], $Results[1]);
  649.         return ($Error);
  650.     }
  651.  
  652.     @{$self->{'fnames'}} = @Results;
  653.  
  654.     foreach (0..$#{$self->{'fnames'}}){
  655.         s/ +$//;
  656.         $self->{'field'}->{${$self->{'fnames'}}[$_]} = $_;
  657.     }
  658.     return undef;
  659. }
  660.  
  661. # ----------------------------------------------------------------------------
  662. # ----------------- D e b u g g i n g   F u n c t i o n s --------------------
  663.  
  664. sub Debug{
  665.     my($self, $iDebug, $File) = @_;
  666.     my(@Results);
  667.     if (! ref($self)){
  668.         if (defined $self){
  669.             $File = $iDebug;
  670.             $iDebug = $self;
  671.         }
  672.         $Connection = 0;
  673.         $self = 0;
  674.     }else{
  675.         $Connection = $self->{'connection'};
  676.     }
  677.     push(@Results, ($Connection, $iDebug));
  678.     push(@Results, $File) if ($File ne "");
  679.     @Results = ODBCDebug(@Results);
  680.     return (processError($self, @Results))[0];
  681. }
  682.  
  683. ####
  684. #   Prints out the current dataset (used mostly for testing)
  685. ####
  686. sub DumpData {
  687.     my($self) = @_; my($f, $goo);
  688.  
  689.         #   Changed by JOC 06-Apr-96
  690.         #   print "\nDumping Data for connection: $conn->{'connection'}\n";
  691.     print "\nDumping Data for connection: $self->{'connection'}\n";
  692.     print "Error: \"";
  693.     print $self->Error();
  694.     print "\"\n";
  695.     if (! $self->Error()){
  696.        foreach $f ($self->FieldNames){
  697.             print $f . " ";
  698.             $goo .= "-" x length($f);
  699.             $goo .= " ";
  700.         }
  701.         print "\n$goo\n";
  702.         while ($self->FetchRow()){
  703.             foreach $f ($self->FieldNames){
  704.                 print $self->data($f) . " ";
  705.             }
  706.             print "\n";
  707.         }
  708.     }
  709. }
  710.  
  711. sub DumpError{
  712.     my($self) = @_;
  713.     my($ErrNum, $ErrText, $ErrConn);
  714.     my($Temp);
  715.  
  716.     print "\n---------- Error Report: ----------\n";
  717.     if (ref $self){
  718.         ($ErrNum, $ErrText, $ErrConn) = $self->Error();
  719.         ($Temp = $self->GetDSN()) =~ s/.*DSN=(.*?);.*/$1/i;
  720.         print "Errors for \"$Temp\" on connection " . $self->{'connection'} . ":\n";
  721.     }else{
  722.         ($ErrNum, $ErrText, $ErrConn) = Error();
  723.         print "Errors for the package:\n";
  724.     }
  725.  
  726.     print "Connection Number: $ErrConn\nError number: $ErrNum\nError message: \"$ErrText\"\n";
  727.     print "-----------------------------------\n";
  728.  
  729. }
  730.  
  731. ####
  732. #   Submit an SQL statement and print data about it (used mostly for testing)
  733. ####
  734. sub Run{
  735.     my($self, $Sql) = @_;
  736.  
  737.     print "\nExcecuting connection $self->{'connection'}\nsql statement: \"$Sql\"\n";
  738.     $self->sql($Sql);
  739.     print "Error: \"";
  740.     print $self->error;
  741.     print "\"\n";
  742.     print "--------------------\n\n";
  743. }
  744.  
  745. # ----------------------------------------------------------------------------
  746. # ----------- E r r o r   P r o c e s s i n g   F u n c t i o n s ------------
  747.  
  748. ####
  749. #   Process Errors returned from a call to ODBCxxxx().
  750. #   It is assumed that the Win32::ODBC function returned the following structure:
  751. #      ($ErrorNumber, $ResultsText, ...)
  752. #           $ErrorNumber....0 = No Error
  753. #                           >0 = Error Number
  754. #           $ResultsText.....if no error then this is the first Results element.
  755. #                           if error then this is the error text.
  756. ####
  757. sub processError{
  758.     my($self, $Error, @Results) = @_;
  759.     if ($Error){
  760.         SetError($self, $Results[0], $Results[1]);
  761.         undef @Results;
  762.     }
  763.     return @Results;
  764. }
  765.  
  766. ####
  767. #   Return the last recorded error message
  768. ####
  769. sub error{
  770.     return (Error(@_));
  771. }
  772.  
  773. sub Error{
  774.     my($self) = @_;
  775.     if(ref($self)){
  776.         if($self->{'ErrNum'}){
  777.             my($State) = ODBCGetSQLState($self->{'connection'});
  778.             return (wantarray)? ($self->{'ErrNum'}, $self->{'ErrText'}, $self->{'connection'}, $State) :"[$self->{'ErrNum'}] [$self->{'connection'}] [$State] \"$self->{'ErrText'}\"";
  779.         }
  780.     }elsif ($ErrNum){
  781.         return (wantarray)? ($ErrNum, $ErrText, $ErrConn):"[$ErrNum] [$ErrConn] \"$ErrText\"";
  782.     }
  783.     return undef
  784. }
  785.  
  786. ####
  787. #   SetError:
  788. #       Assume that if $self is not a reference then it is just a placeholder
  789. #       and should be ignored.
  790. ####
  791. sub SetError{
  792.     my($self, $Num, $Text, $Conn) = @_;
  793.     if (ref $self){
  794.         $self->{'ErrNum'} = $Num;
  795.         $self->{'ErrText'} = $Text;
  796.         $Conn = $self->{'connection'} if ! $Conn;
  797.     }
  798.     $ErrNum = $Num;
  799.     $ErrText = $Text;
  800.  
  801.         ####
  802.         #   Test Section Begin
  803.         ####
  804. #    $! = ($Num, $Text);
  805.         ####
  806.         #   Test Section End
  807.         ####
  808.  
  809.     $ErrConn = $Conn;
  810. }
  811.  
  812. sub ClearError{
  813.     my($self, $Num, $Text) = @_;
  814.     if (ref $self){
  815.         undef $self->{'ErrNum'};
  816.         undef $self->{'ErrText'};
  817.     }else{
  818.         undef $ErrConn;
  819.         undef $ErrNum;
  820.         undef $ErrText;
  821.     }
  822.     ODBCCleanError();
  823.     return 1;
  824. }
  825.  
  826.  
  827. sub GetError{
  828.     my($self, $Connection) = @_;
  829.     my(@Results);
  830.     if (! ref($self)){
  831.         $Connection = $self;
  832.         $self = 0;
  833.     }else{
  834.         if (! defined($Connection)){
  835.             $Connection = $self->{'connection'};
  836.         }
  837.     }
  838.  
  839.     @Results = ODBCGetError($Connection);
  840.     return @Results;
  841. }
  842.  
  843.  
  844.  
  845.  
  846. # ----------------------------------------------------------------------------
  847. # ------------------ A U T O L O A D   F U N C T I O N -----------------------
  848.  
  849. sub AUTOLOAD {
  850.     # This AUTOLOAD is used to 'autoload' constants from the constant()
  851.     # XS function.  If a constant is not found then control is passed
  852.     # to the AUTOLOAD in AutoLoader.
  853.  
  854.     my($constname);
  855.     ($constname = $AUTOLOAD) =~ s/.*:://;
  856.     #reset $! to zero to reset any current errors.
  857.     $!=0;
  858.     $val = constant($constname, @_ ? $_[0] : 0);
  859.  
  860.     if ($! != 0) {
  861.     if ($! =~ /Invalid/) {
  862.         $AutoLoader::AUTOLOAD = $AUTOLOAD;
  863.         goto &AutoLoader::AUTOLOAD;
  864.     }
  865.     else {
  866.  
  867.             # Added by JOC 06-APR-96
  868.             # $pack = 0;
  869.         $pack = 0;
  870.         ($pack,$file,$line) = caller;
  871.             print "Your vendor has not defined Win32::ODBC macro $constname, used in $file at line $line.";
  872.     }
  873.     }
  874.     eval "sub $AUTOLOAD { $val }";
  875.     goto &$AUTOLOAD;
  876. }
  877.  
  878.  
  879.     #   --------------------------------------------------------------
  880.     #
  881.     #
  882.     #   Make sure that we shutdown ODBC and free memory even if we are
  883.     #   using perlis.dll on Win32 platform!
  884. END{
  885. #    ODBCShutDown() unless $CacheConnection;
  886. }
  887.  
  888.  
  889. bootstrap Win32::ODBC;
  890.  
  891. # Preloaded methods go here.
  892.  
  893. # Autoload methods go after __END__, and are processed by the autosplit program.
  894.  
  895. 1;
  896. __END__
  897.  
  898.  
  899.  
  900.